home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / bbs / pcsuni1.zip / HOHO302.ZIP / HOHAUS5.PPE (.txt) < prev    next >
PCBoard Programming Language Executable  |  1997-03-24  |  10KB  |  414 lines
  1. ;------------------------------------------------------------------------------
  2. ;                                                   .ss.
  3. ;                                                   `²²'
  4. ;             .,sS$Ss,,s$  .,sS$$$Ss.  .,sS$Ss,,s$ .ss.  .sSs.
  5. ;           .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
  6. ;           $$$'   .$$$' $$$²Sçsµ²' .$$$'   .$$$'.$$$' .$$$'  `$$b.
  7. ;           $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$'    ;$$$
  8. ;           `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
  9. ;                                    .sS²°$$$²²°"'       d²°'
  10. ;                                  .$$²  .$$'
  11. ;                                  $$$.,d$$'
  12. ;                                  `²S$$S²'
  13. ;------------------------------------------------------------------------------
  14. ; P.P.L.X. 2.OO                          (C)1996 - Lone Runner / AEGiS CoRP'96 
  15. ;------------------------------------------------------------------------------
  16. ; PPE 3.2O (Encryption type I) - Analysis ON - Postprocessing ON
  17. ;------------------------------------------------------------------------------
  18.  
  19.     Integer  INTEGER001
  20.     Integer  INTEGER002
  21.     Integer  INTEGER003
  22.     Integer  INTEGER004
  23.     Integer  INTEGER005
  24.     Integer  INTEGER006
  25.     Integer  INTEGER007
  26.     Integer  INTEGER008
  27.     Integer  INTEGER009
  28.     Integer  INTEGER010
  29.     Integer  INTEGER011
  30.     Integer  INTEGER012
  31.     Integer  INTEGER013
  32.     Integer  INTEGER014
  33.     Integer  INTEGER015
  34.     Integer  INTEGER016
  35.     String   STRING001
  36.     String   STRING002
  37.     String   STRING003
  38.     String   STRING004
  39.     String   TSTRING005(16)
  40.     String   TSTRING006(33)
  41.  
  42. ;------------------------------------------------------------------------------
  43.  
  44.     If (CurSec() < SysopSec()) End
  45.     STRING003 = "@X0C√@X07"
  46.     STRING004 = "@X0A√@X07"
  47.     If (!Exist(PPEPath() + "PCS.DBF")) Gosub LABEL002
  48.     If (!Exist(PPEPath() + "HOHAUS.DBF")) Gosub LABEL003
  49.     DOpen 6, PPEPath() + "PCS.DBF", 0
  50.     DTop 6
  51.     DGet 6, "DAYDELETE", INTEGER002
  52.     DGet 6, "HOPICK", INTEGER003
  53.     DGet 6, "NDAYS", INTEGER004
  54.     DGet 6, "HOEARN", INTEGER005
  55.     DGet 6, "UPCOST", INTEGER006
  56.     DGet 6, "TRANS_LMT", INTEGER009
  57.     DGet 6, "OPD", INTEGER010
  58.     DGet 6, "ODDS", INTEGER011
  59.     DGet 6, "NOD", INTEGER012
  60.     DGet 6, "NOSEJOB", INTEGER014
  61.     DGet 6, "MAMMARY", INTEGER015
  62.     DGet 6, "STD", INTEGER016
  63.     DGet 6, "NOB", INTEGER013
  64.     DGet 6, "ENTRIES", INTEGER008
  65.     :LABEL001
  66.     STRING001 = ""
  67.     INTEGER001 = 0
  68.     Cls
  69.     StartDisp 1
  70.     PrintLn "  @X10┌─────────────────────────────────────────────────────────────────────────@X19┐@X0F"
  71.     PrintLn "  @X10│       @X1EHo' House System Editor       (c)1996 Practical Computer Services@X1B @X19│@X0F"
  72.     PrintLn "  @X10│  @X1EA@X1A]@X1B Realtime Days to Non-Active User Deletion     @X1A[@X1F", INTEGER002, "@X1A]@POS:77@@X19│@X0F"
  73.     PrintLn "  @X10│  @X1EB@X1A]@X1B Number of @X1A[@X1EF@X1A]@X1Bind Whore options per Game Day   @X1A[@X1F", INTEGER003, "@X1A]@POS:77@@X19│@X0F"
  74.     PrintLn "  @X10│  @X1EC@X1A]@X1B Number of @X1A[@X1EN@X1A]@X1Bext Day options per Session      @X1A[@X1F", INTEGER004, "@X1A]@POS:77@@X19│@X0F"
  75.     PrintLn "  @X10│  @X1ED@X1A]@X1B Whore Earnings:       (Looks * Breast Size) * @X1A[@X1F", INTEGER005, "@X1A]@POS:77@@X19│@X0F"
  76.     PrintLn "  @X10│  @X1EE@X1A]@X1B Upgrade Cost:                (Level * 5000) * @X1A[@X1F", INTEGER006, "@X1A]@POS:77@@X19│@X0F"
  77.     PrintLn "  @X10│  @X1EF@X1A]@X1B Plastic Surgery Multiplier:                   @X1A[@X1F", INTEGER014, "@X1A]@POS:77@@X19│@X0F"
  78.     PrintLn "  @X10│  @X1EG@X1A]@X1B Breast Enlargement Multiplier:                @X1A[@X1F", INTEGER015, "@X1A]@POS:77@@X19│@X0F"
  79.     PrintLn "  @X10│  @X1EH@X1A]@X1B STD Treatment Multiplier:                     @X1A[@X1F", INTEGER016, "@X1A]@POS:77@@X19│@X0F"
  80.     PrintLn "  @X10│  @X1EI@X1A]@X1B Transfer Limit per Session                    @X1A[@X1F", INTEGER009, "@X1A]@POS:77@@X19│@X0F"
  81.     PrintLn "  @X10│  @X1EJ@X1A]@X1B Offensive Actions per Game Day                @X1A[@X1F", INTEGER010, "@X1A]@POS:77@@X19│@X0F"
  82.     PrintLn "  @X10│  @X1EK@X1A]@X1B Gambling Odds:     Chance of Winning is  1 in @X1A[@X1F", INTEGER011, "@X1A]@POS:77@@X19│@X0F"
  83.     PrintLn "  @X10│  @X1EL@X1A]@X1B Number of gambling sessions per day           @X1A[@X1F", INTEGER013, "@X1A]@POS:77@@X19│@X0F"
  84.     PrintLn "  @X10│  @X1EM@X1A]@X1B Realtime Days to Graffiti Wall Re-Init        @X1A[@X1F", INTEGER012, "@X1A]@POS:77@@X19│@X0F"
  85.     PrintLn "  @X10│  @X1EN@X1A]@X1B Delete a Player           @POS:77@@X19│@X0F"
  86.     PrintLn "  @X10│  @X1EO@X1A]@X1B Pack the User Database                          @POS:77@@X19│@X0F"
  87.     PrintLn "  @X10│  @X1EP@X1A]@X1B Per day user entries to the game:             @X1A[@X1F", INTEGER008, "@X1A]@POS:77@@X19│@X0F"
  88.     PrintLn "  @X10│  @X9CZ@X1A] @X1CRECREATE CONFIGURATION DATABASE@X1B  @POS:77@@X19│@X0F"
  89.     PrintLn "  @X10│  @X1CQ@X1A]@X1B @X9CQ@X9CU@X9CI@X9CT@X1B                                                                @X19│@X0F"
  90.     PrintLn "  @X10└@X19─────────────────────────────────────────────────────────────────────────┘@X0F"
  91.     Newline
  92.     InputStr "SELECTION: _", STRING001, 15, 1, "ABCDEFGHIJKLMNOPQZ", 0 + 8
  93.     Select Case (STRING001)
  94.         Case "A"
  95.             Backup 80
  96.             ClrEol
  97.             InputStr "NEW VALUE: _", INTEGER002, 15, 3, Mask_Num(), 0
  98.             DPut 6, "DAYDELETE", Abs(INTEGER002)
  99.             Goto LABEL001
  100.         Case "B"
  101.             Backup 80
  102.             ClrEol
  103.             InputStr "NEW VALUE: _", INTEGER003, 15, 2, Mask_Num(), 0
  104.             DPut 6, "HOPICK", Abs(INTEGER003)
  105.             Goto LABEL001
  106.         Case "C"
  107.             Backup 80
  108.             ClrEol
  109.             InputStr "NEW VALUE: _", INTEGER004, 15, 3, Mask_Num(), 0
  110.             DPut 6, "NDAYS", Abs(INTEGER004)
  111.             Goto LABEL001
  112.         Case "D"
  113.             Backup 80
  114.             ClrEol
  115.             InputStr "NEW VALUE: _", INTEGER005, 15, 2, Mask_Num(), 0
  116.             DPut 6, "HOEARN", Abs(INTEGER005)
  117.             Goto LABEL001
  118.         Case "E"
  119.             Backup 80
  120.             ClrEol
  121.             InputStr "NEW VALUE: _", INTEGER006, 15, 3, Mask_Num(), 0
  122.             DPut 6, "UPCOST", Abs(INTEGER006)
  123.             Goto LABEL001
  124.         Case "F"
  125.             Backup 80
  126.             ClrEol
  127.             InputStr "NEW VALUE: _", INTEGER014, 15, 3, Mask_Num(), 0
  128.             DPut 6, "NOSEJOB", Abs(INTEGER014)
  129.             Goto LABEL001
  130.         Case "G"
  131.             Backup 80
  132.             ClrEol
  133.             InputStr "NEW VALUE: _", INTEGER015, 15, 3, Mask_Num(), 0
  134.             DPut 6, "MAMMARY", Abs(INTEGER015)
  135.             Goto LABEL001
  136.         Case "H"
  137.             Backup 80
  138.             ClrEol
  139.             InputStr "NEW VALUE: _", INTEGER016, 15, 3, Mask_Num(), 0
  140.             DPut 6, "STD", Abs(INTEGER016)
  141.             Goto LABEL001
  142.         Case "I"
  143.             Backup 80
  144.             ClrEol
  145.             InputStr "NEW VALUE: _", INTEGER009, 15, 5, Mask_Num(), 0
  146.             DPut 6, "TRANS_LMT", Abs(INTEGER009)
  147.             Goto LABEL001
  148.         Case "J"
  149.             Backup 80
  150.             ClrEol
  151.             InputStr "NEW VALUE: _", INTEGER010, 15, 2, Mask_Num(), 0
  152.             DPut 6, "OPD", Abs(INTEGER010)
  153.             Goto LABEL001
  154.         Case "K"
  155.             Backup 80
  156.             ClrEol
  157.             InputStr "NEW VALUE: _", INTEGER011, 15, 3, Mask_Num(), 0
  158.             DPut 6, "ODDS", Abs(INTEGER011)
  159.             Goto LABEL001
  160.         Case "L"
  161.             Backup 80
  162.             ClrEol
  163.             InputStr "NEW VALUE: _", INTEGER013, 15, 3, Mask_Num(), 0
  164.             DPut 6, "NOB", Abs(INTEGER013)
  165.             Goto LABEL001
  166.         Case "M"
  167.             Backup 80
  168.             ClrEol
  169.             InputStr "NEW VALUE: _", INTEGER012, 15, 3, Mask_Num(), 0
  170.             DPut 6, "NOD", Abs(INTEGER012)
  171.             Goto LABEL001
  172.         Case "N"
  173.             Backup 80
  174.             ClrEol
  175.             InputStr "USER TO DELETE: _", STRING001, 15, 25, Mask_Ascii(), 0 + 8
  176.             If (STRING001 == "") Goto LABEL001
  177.             DClose 0
  178.             DOpen 0, PPEPath() + "HOHAUS.DBF", 0
  179.             STRING002 = String(Random(1000)) + "X" + PcbNode() + ".NDX"
  180.             DnCreate 0, STRING002, "NAME"
  181.             DSeek 0, STRING001
  182.             If (DChkStat(0) > 0) Then
  183.                 Cls
  184.                 Newlines 10
  185.                 PrintLn "  @X40┌─────────────────────────────────────────────────────────────────────────@X4C┐@X0F"
  186.                 PrintLn "  @X40│              @XCETHAT USER WAS NOT FOUND IN THE DATABASE!@X40                   @X4C│@X0F"
  187.                 PrintLn "  @X40└@X4C─────────────────────────────────────────────────────────────────────────┘@X0F"
  188.                 Delay (2 * 182) / 10
  189.                 Goto LABEL001
  190.             Endif
  191.             DOpen 2, PPEPath() + "LADIES.DBF", 0
  192.             DTop 2
  193.             For INTEGER007 = 1 To DRecCount(2)
  194.                 If (Strip(DGet(2, "OWNEDBY"), " ") == Strip(DGet(0, "HANDLE"), " ")) Then
  195.                     DPut 2, "OWNEDBY", "NONE"
  196.                     Print STRING003
  197.                 Endif
  198.                 Print STRING004
  199.                 DSkip 2, 1
  200.             Next
  201.             DBlank 0
  202.             DDelete 0
  203.             DPack 0
  204.             DPack 2
  205.             DCloseAll
  206.             Delete PPEPath() + STRING002
  207.             Goto LABEL001
  208.         Case "O"
  209.             DClose 0
  210.             DOpen 0, PPEPath() + "HOHAUS.DBF", 0
  211.             DPack 0
  212.             DClose 0
  213.             Backup 80
  214.             ClrEol
  215.             PrintLn "@X8EDatabase Packed!@X0F"
  216.             Delay (3 * 182) / 10
  217.             Goto LABEL001
  218.         Case "P"
  219.             Backup 80
  220.             ClrEol
  221.             InputStr "NEW VALUE: _", INTEGER008, 15, 3, Mask_Num(), 0
  222.             DPut 6, "ENTRIES", Abs(INTEGER008)
  223.             Goto LABEL001
  224.         Case "Z"
  225.             Goto LABEL002
  226.         Case "Q"
  227.             Goto LABEL004
  228.     End Select
  229.     :LABEL002
  230.     TSTRING005(1) = "MAINTDATE,N,6,0"
  231.     TSTRING005(2) = "DAYDELETE,N,3,0"
  232.     TSTRING005(3) = "HOPICK,N,2,0"
  233.     TSTRING005(4) = "NDAYS,N,2,0"
  234.     TSTRING005(5) = "HOEARN,N,2,0"
  235.     TSTRING005(6) = "UPCOST,N,2,0"
  236.     TSTRING005(7) = "TRANS_LMT,N,6,0"
  237.     TSTRING005(8) = "OPD,N,2,0"
  238.     TSTRING005(9) = "ODDS,N,2,0"
  239.     TSTRING005(10) = "ROBOTS,C,1,0"
  240.     TSTRING005(11) = "NOD,N,3,0"
  241.     TSTRING005(12) = "NOSEJOB,N,3,0"
  242.     TSTRING005(13) = "MAMMARY,N,3,0"
  243.     TSTRING005(14) = "STD,N,3,0"
  244.     TSTRING005(15) = "NOB,N,2,0"
  245.     TSTRING005(16) = "ENTRIES,N,2,0"
  246.     DCloseAll
  247.     If (Exist(PPEPath() + "PCS.DBF")) Delete PPEPath() + "PCS.DBF"
  248.     DCreate 0, PPEPath() + "PCS.DBF", 0, TSTRING005(BOOLEAN000)
  249.     DTop 0
  250.     DNew 0
  251.     DPut 0, "MAINTDATE", ToInteger(Date())
  252.     DPut 0, "DAYDELETE", 60
  253.     DPut 0, "HOPICK", 3
  254.     DPut 0, "NDAYS", 7
  255.     DPut 0, "HOEARN", 5
  256.     DPut 0, "UPCOST", 5
  257.     DPut 0, "TRANS_LMT", 5000
  258.     DPut 0, "OPD", 4
  259.     DPut 0, "ODDS", 6
  260.     DPut 0, "ROBOTS", "N"
  261.     DPut 0, "NOD", 14
  262.     DPut 0, "NOSEJOB", 30
  263.     DPut 0, "MAMMARY", 100
  264.     DPut 0, "STD", 2
  265.     DPut 0, "NOB", 3
  266.     DPut 0, "ENTRIES", 3
  267.     DAdd 0
  268.     DTop 0
  269.     DPack 0
  270.     DCloseAll
  271.     Return
  272.     :LABEL003
  273.     TSTRING006(1) = "NAME,C,25,0"
  274.     TSTRING006(2) = "HANDLE,C,25,0"
  275.     TSTRING006(3) = "NETWORTH,N,12,0"
  276.     TSTRING006(4) = "LEVEL,N,3,0"
  277.     TSTRING006(5) = "STATUS,C,6,0"
  278.     TSTRING006(6) = "KILLS,N,4,0"
  279.     TSTRING006(7) = "C_ACT_L,N,3,0"
  280.     TSTRING006(8) = "MUSCLE,N,2,0"
  281.     TSTRING006(9) = "DEFENSE,N,3,0"
  282.     TSTRING006(10) = "CASH,N,9,0"
  283.     TSTRING006(11) = "BANKED,N,9,0"
  284.     TSTRING006(12) = "BRIBEAMT,N,9,0"
  285.     TSTRING006(13) = "L_DATE,N,5,0"
  286.     TSTRING006(14) = "MAIL_NUM,C,8,0"
  287.     TSTRING006(15) = "TRSF_AMT,N,8,0"
  288.     TSTRING006(16) = "PLAYED,N,3,0"
  289.     TSTRING006(17) = "MESSAGE,C,50,0"
  290.     TSTRING006(18) = "G1,N,4,0"
  291.     TSTRING006(19) = "G2,N,4,0"
  292.     TSTRING006(20) = "G3,N,4,0"
  293.     TSTRING006(21) = "G4,N,4,0"
  294.     TSTRING006(22) = "G5,N,4,0"
  295.     TSTRING006(23) = "G6,N,4,0"
  296.     TSTRING006(24) = "G7,N,4,0"
  297.     TSTRING006(25) = "G8,N,4,0"
  298.     TSTRING006(26) = "G9,N,4,0"
  299.     TSTRING006(27) = "G10,N,4,0"
  300.     TSTRING006(28) = "CONDOMS,N,4,0"
  301.     TSTRING006(29) = "LOOKS,N,1,0"
  302.     TSTRING006(30) = "SLUT_TOT,2,N,0"
  303.     TSTRING006(31) = "TARGET,3,N,0"
  304.     TSTRING006(32) = "NO_BET,2,N,0"
  305.     TSTRING006(33) = "ENTRIES,2,N,0"
  306.     DCreate 0, PPEPath() + "HOHAUS.DBF", 0, TSTRING006(BOOLEAN000)
  307.     DCloseAll
  308.     DOpen 0, PPEPath() + "HOHAUS.DBF", 0
  309.     DNew 0
  310.     DPut 0, "NAME", "PCS SOFTWARE"
  311.     DPut 0, "HANDLE", "PCS SOFTWARE"
  312.     DPut 0, "MAIL_NUM", "PCS"
  313.     DPut 0, "MESSAGE", "(C)1996 PCS SOFTWARE"
  314.     DAdd 0
  315.     DCloseAll
  316.     Return
  317.     :LABEL004
  318.     DCloseAll
  319.     Delete PPEPath() + STRING002
  320.     End
  321.  
  322. ;------------------------------------------------------------------------------
  323. ;
  324. ; Usage report (before postprocessing)
  325. ;
  326. ; ■ Statements used :
  327. ;
  328. ;    2       End
  329. ;    2       Cls
  330. ;    16      ClrEol
  331. ;    59      Goto 
  332. ;    56      Let 
  333. ;    2       Print 
  334. ;    25      PrintLn 
  335. ;    26      If 
  336. ;    1       StartDisp 
  337. ;    3       Delete 
  338. ;    16      InputStr 
  339. ;    2       Gosub 
  340. ;    2       Return
  341. ;    2       Delay 
  342. ;    1       Newline
  343. ;    1       Newlines 
  344. ;    16      Backup 
  345. ;    2       DCreate 
  346. ;    5       DOpen 
  347. ;    3       DClose 
  348. ;    4       DPack 
  349. ;    6       DCloseAll
  350. ;    1       DnCreate 
  351. ;    2       DNew 
  352. ;    2       DAdd 
  353. ;    4       DTop 
  354. ;    1       DSkip 
  355. ;    1       DBlank 
  356. ;    1       DDelete 
  357. ;    1       DSeek 
  358. ;    14      DGet 
  359. ;    35      DPut 
  360. ;
  361. ;
  362. ; ■ Functions used :
  363. ;
  364. ;    2       *
  365. ;    2       /
  366. ;    19      +
  367. ;    20      ==
  368. ;    2       <
  369. ;    1       <=
  370. ;    1       >
  371. ;    2       >=
  372. ;    23      !
  373. ;    2       &&
  374. ;    1       ||
  375. ;    1       Random()
  376. ;    1       Date()
  377. ;    2       Strip()
  378. ;    1       String()
  379. ;    14      Mask_Num()
  380. ;    1       Mask_Ascii()
  381. ;    13      PPEPath()
  382. ;    1       PcbNode()
  383. ;    1       SysopSec()
  384. ;    1       CurSec()
  385. ;    3       Exist()
  386. ;    14      Abs()
  387. ;    1       ToInteger()
  388. ;    2       DRecCount()
  389. ;    2       DGet()
  390. ;    1       DChkStat()
  391. ;
  392. ;------------------------------------------------------------------------------
  393. ;
  394. ; Analysis flags : s
  395. ;
  396. ; s - Sysop level access ■ 5
  397. ;     Program is reading the sysop access level, this may be normal
  398. ;     but still it is very suspect. It is the best way to give a user
  399. ;     all priviledges. Check!
  400. ;     ■ Search for : SYSOPSEC()
  401. ;
  402. ;------------------------------------------------------------------------------
  403. ;
  404. ; Postprocessing report
  405. ;
  406. ;    1       For/Next
  407. ;    0       While/EndWhile
  408. ;    2       If/Then or If/Then/Else
  409. ;    1       Select Case
  410. ;
  411. ;------------------------------------------------------------------------------
  412. ;                 AEGiS Corp - Break the routines, code against the machines!
  413. ;------------------------------------------------------------------------------
  414.